home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / packet / terminal / top_152 / src152.exe / rar / TOPXMS.PAS < prev   
Pascal/Delphi Source File  |  1995-05-16  |  3KB  |  147 lines
  1. Unit TOPXMS;
  2. {$F+}
  3.  
  4. Interface
  5.  
  6.  
  7. Const  ixms = $2F;
  8.  
  9. Var     XMS_Version,
  10.         XMS_Treiber,
  11.         HMA           : Word;
  12.         XMS_installed : Boolean;
  13.         Failure       : Byte;
  14.  
  15.         XmsControl    : Pointer;
  16.  
  17.         RecXms : record                    { XMS-INFOBLOCK        }
  18.                    Len       : LongInt;    { length of Bytes      }
  19.                    fr_Handle : Word;       { source handle        }
  20.                    fr_Adr    : LongInt;    { source pointer       }
  21.                    to_Handle : Word;       { destination handle   }
  22.                    to_Adr    : LongInt;    { destination pointer  }
  23.                  end;
  24.  
  25.  
  26. Procedure get_XMS_Install;
  27. Function  get_XMS_Free : Word;
  28. Function  get_XMS_Ram(SizeKb : Word) : Word;
  29. Procedure Free_XMS_Ram(Handle : Word);
  30. Procedure Data_To_XMS(Source : Pointer; Handle : Word; Adresse,Count : LongInt);
  31. Procedure Xms_To_Data(Source : Pointer; Handle : Word; Adresse,Count : LongInt);
  32. Procedure Init_XMS;
  33.  
  34. Implementation
  35.  
  36. Procedure get_XMS_Install;
  37. var    Erg : Byte;
  38. Begin
  39.   Erg := 0;
  40.   if not XMS_installed then
  41.   begin
  42.     asm  mov  ax, $4300
  43.          int  ixms
  44.          mov  Erg, al
  45.          cmp  al, $80
  46.          jne  @NoDrv
  47.  
  48.          mov  ax, $4310
  49.          int  ixms
  50.          mov  Word(XmsControl),bx
  51.          mov  Word(XmsControl+2),es
  52.  
  53.          xor  ah,ah
  54.          call XmsControl
  55.          mov  XMS_Version,ax
  56.          mov  XMS_Treiber,bx
  57.          mov  HMA,dx
  58.  
  59.       @NoDrv:
  60.     end;
  61.     XMS_installed := (Erg = $80);
  62.   end;
  63. End;
  64.  
  65. Function get_XMS_Free : Word;
  66. var    Free : Word;
  67. Begin
  68.   asm  mov  ah,$08
  69.        call XmsControl
  70.        mov  Free,ax
  71.        mov  Failure,bl
  72.   end;
  73.   get_XMS_Free := Free;
  74. End;
  75.  
  76. Function  get_XMS_Ram(SizeKb : Word) : Word;
  77. var     Handle : Word;
  78. Begin
  79.   asm  mov  ah, $09
  80.        mov  dx, SizeKb
  81.        call XmsControl;
  82.        mov  Handle, dx
  83.   end;
  84.   get_XMS_Ram := Handle;
  85. End;
  86.  
  87. Procedure Free_XMS_Ram(Handle : Word);
  88. Begin
  89.   asm  mov  ah, $0A
  90.        mov  dx, Handle
  91.        call XmsControl;
  92.   end;
  93. End;
  94.  
  95.  
  96. Procedure Data_To_XMS(Source : Pointer; Handle : Word; Adresse,Count : LongInt);
  97. var      Erg : Word;
  98.          m   : Pointer;
  99. Begin
  100.   m := Addr(RecXms);
  101.   If Count mod 2 <> 0 then inc(Count);
  102.  
  103.   RecXms.Len := count;
  104.   RecXms.fr_Handle := 0;
  105.   RecXms.fr_Adr := LongInt(Source);
  106.   RecXms.to_Handle := handle;
  107.   RecXms.to_adr := Adresse;
  108.   asm  mov  ah, $0b
  109.        mov  si, Word [m]
  110.        mov  bl,0
  111.        call XmsControl
  112.        mov  Erg, ax
  113.        mov  Failure,bl
  114.   end;
  115. End;
  116.  
  117.  
  118. Procedure Xms_To_Data(Source : Pointer; Handle : Word; Adresse,Count : LongInt);
  119. var      Erg : Word;
  120.          m   : Pointer;
  121. Begin
  122.   m := Addr(RecXms);
  123.   If Count mod 2 <> 0 then inc(Count);
  124.  
  125.   RecXms.Len := count;
  126.   RecXms.to_Handle := 0;
  127.   RecXms.to_adr := LongInt(Source);
  128.   RecXms.fr_Handle := Handle;
  129.   RecXms.fr_Adr := Adresse;
  130.  
  131.   asm  mov  ah, $0b
  132.        mov  si, Word [m]
  133.        mov  bl,0
  134.        call XmsControl
  135.        mov  Erg, ax
  136.        mov  Failure,bl
  137.   end;
  138. End;
  139.  
  140. Procedure Init_XMS;
  141. Begin
  142.   XMS_installed := false;
  143.   get_XMS_Install;
  144. End;
  145.  
  146. End.
  147.